home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRON / PCB_DESI / H027.ZIP / TOOLS.EXE / lha / LAYOTOOL.PAS < prev    next >
Pascal/Delphi Source File  |  1990-11-21  |  6KB  |  284 lines
  1. program layotool;
  2.  
  3. {  PROGRAMM EXAMPLES Layo1 PCB-CAD-CAM SOFTWARE  REV 4.90  }
  4.  
  5. {  MAKE YOUR OWN TOOLS !!  }
  6.  
  7. uses
  8.   crt;
  9.  
  10. const
  11. {  max_data = $7FEF; }
  12.   max_data = 2046;
  13.   remark = '****************************************************************';
  14.  
  15. type
  16.   string100 = string[100];
  17.  
  18.   wrd_array = array[0..max_data] of word;
  19.   int_array = array[0..max_data] of integer;
  20.  
  21. var
  22.   block : ^wrd_array;
  23.   attr : ^wrd_array;
  24.   xpos  : ^int_array;
  25.   ypos  : ^int_array;
  26.   net   : ^wrd_array;
  27.  
  28.   top_array : word;
  29.  
  30.   board_offset_x : integer;
  31.   board_offset_y : integer;
  32.   board_size_x   : integer;
  33.   board_size_y   : integer;
  34.  
  35.   f2 : text;
  36.  
  37.  
  38. procedure init;
  39. begin
  40.   new(block); fillchar(block^,sizeof(block^),0);
  41.   new(attr);  fillchar(attr^ ,sizeof(attr^) ,0);
  42.   new(xpos);  fillchar(xpos^ ,sizeof(xpos^) ,0);
  43.   new(ypos);  fillchar(ypos^ ,sizeof(ypos^) ,0);
  44.   new(net);   fillchar(net^  ,sizeof(net^)  ,0);
  45.   top_array := 0;
  46. end;
  47.  
  48.  
  49.  
  50.  
  51. procedure load_ply(f_name:string100;var ok:boolean);
  52.  
  53. type
  54.   ply_rec = record
  55.               blk : word;
  56.               att : word;
  57.               xps : integer;
  58.               yps : integer;
  59.               net : word;
  60.             end;
  61.  
  62. var
  63.   i      : word;
  64.   f1     : file of ply_rec;
  65.   f1_rec : ply_rec;
  66.   f1_len : word;
  67. begin
  68.   assign(f1,f_name);
  69.   {$I-} reset(F1) {$I+};
  70.   ok:=(ioresult = 0);
  71.   if not ok then
  72.   begin
  73.     writeln(f2,f_name,' not found...');
  74.     exit;
  75.   end;
  76.   f1_len := filesize(f1);
  77.   if f1_len > max_data then
  78.   begin
  79.     writeln(f2,'file to long (',f1_len,') datalines...');
  80.     exit;
  81.   end;
  82.  
  83.   for i := 1 to f1_len do
  84.   begin
  85.     read(f1,f1_rec);
  86.     block^[i] := f1_rec.blk;
  87.     attr^[i]  := f1_rec.att;
  88.     xpos^[i]  := f1_rec.xps;
  89.     ypos^[i]  := f1_rec.yps;
  90.     net^[i]   := f1_rec.net;
  91.   end;
  92.   close(f1);
  93.   top_array := f1_len;
  94.   board_offset_x := xpos^[2] + 8;
  95.   board_offset_y := ypos^[2] + 8;
  96.   board_size_x   := (xpos^[8] - xpos^[2]) - 16;
  97.   board_size_y   := (ypos^[8] - ypos^[2]) - 16;
  98. end;
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105. procedure show_fixed_data;
  106. var
  107.   i : word;
  108. begin
  109.   clrscr;
  110.   writeln(f2,'    line   block    attr     net    xpos    ypos');
  111.   window(1,2,80,24);
  112.   for i := 1 to top_array do
  113.   begin
  114.     writeln(f2,i:8,block^[i]:8,attr^[i]:8,net^[i]:8,xpos^[i]:8,ypos^[i]:8);
  115.   end;
  116.   window(1,1,80,25)
  117. end;
  118.  
  119.  
  120.  
  121.  
  122. procedure show_net_data;
  123. var
  124.   i : word;
  125. begin
  126.   clrscr;
  127.   for i := 1 to top_array do
  128.   begin
  129.     if net^[i] and $1FFF > 0 then writeln(f2,i:4,' net = ',net^[i] and $1FFF);
  130.   end;
  131. end;
  132.  
  133. procedure show_block_data;
  134. var
  135.   i : word;
  136. begin
  137.   clrscr;
  138.   for i := 1 to top_array do
  139.   begin
  140.     if block^[i] and $1FFF > 0
  141.                 then writeln(f2,i:4,' block = ',block^[i] and $1FFF);
  142.   end;
  143. end;
  144.  
  145.  
  146. procedure show_pad(atr,blk:word);
  147. var
  148.   xm,
  149.   ym : boolean;
  150. begin
  151.   if atr and $80 = $80 then write(f2,'pad = ',atr and $78 shr 3:3,
  152.                                   '  tool = ',(blk shr 10) + (atr and 7):3)
  153.   else
  154.   if atr and $100 = $100 then write(f2,'pad = ',atr and $7F:3,
  155.                                      ' Layer = 1 ')
  156.   else
  157.   if atr and $200 = $200 then write(f2,'pad = ',atr and $7F:3,
  158.                                      ' Layer = 2 ');
  159.  
  160.   write(f2,' Rot. = ',(atr shr 10 and $3F) * 7.5 :6:1,' Degr.');
  161.   writeln(f2,' x_mirr = ',blk shr 15,' y_mirr = ',blk shr 14 and 1);
  162. end;
  163.  
  164.  
  165. procedure show_pen_data(atr:word);
  166. begin
  167.   writeln(f2,'layer = ',atr and $78 shr 3:3,'   pen = ',atr and 7:3);
  168. end;
  169.  
  170.  
  171. procedure show_data;
  172. var
  173.   i : word;
  174. begin
  175.   clrscr;
  176.   for i := 1 to top_array do if attr^[i] and $380 > 0
  177.  
  178.   then show_pad(attr^[i],block^[i]) else show_pen_data(attr^[i]);
  179. end;
  180.  
  181.  
  182. procedure show_cnf(f_name:string100);
  183. var
  184.   f1 : text;
  185.   w1 : string100;
  186.   i,
  187.   max_pad_read : word;
  188. begin
  189.   assign(f1,f_name);
  190.   {$I-} reset(f1);  {$i+}
  191.   if ioresult > 0 then
  192.   begin
  193.     writeln(f2,f_name,' not found...');
  194.     exit;
  195.   end;
  196.   readln(f1,w1); writeln(f2,'version : ',w1);
  197.   max_pad_read := 15;
  198.   if pos('4.85',w1) > 0 then max_pad_read := 127;
  199.   readln(f1,w1); writeln(f2,'program_name : ',w1);
  200.   readln(f1,w1); writeln(f2,'file_name : ',w1);
  201.   readln(f1,w1); writeln(f2);
  202.   readln(f1,w1); writeln(f2);
  203.   readln(f1,w1); writeln(f2,'board_size_x : ',w1);
  204.   readln(f1,w1); writeln(f2,'board_size_y : ',w1);
  205.   readln(f1,w1); writeln(f2,'board_offset_x : ',w1);
  206.   readln(f1,w1); writeln(f2,'board_offset_y : ',w1);
  207.   readln(f1,w1); writeln(f2,'LAY file_name : ',w1);
  208.   readln(f1,w1); writeln(f2,'PLY file_name : ',w1);
  209.   readln(f1,w1); writeln(f2,'CMP file_name : ',w1);
  210.   readln(f1,w1); writeln(f2,'NET file_name : ',w1);
  211.   for i:=1 to 6 do
  212.   begin
  213.     readln(f1,w1); {notting}
  214.     writeln(f2);
  215.   end;
  216.   for i:=0 to 15 do
  217.   begin
  218.     readln(f1,w1);
  219.     writeln(f2,'tool_diam[',i,'] : ',w1);
  220.   end;
  221.   readln(f1,w1);
  222.   writeln(f2,'pad_type       x-      y-     x+    y+    corner');
  223.   for i:=0 to max_pad_read do
  224.   begin
  225.     readln(f1,w1);
  226.     writeln(f2,copy(w1,1,8),   { pad type  }
  227.                copy(w1,9,8),   { x1 }
  228.                copy(w1,17,8),  { y1 }
  229.                copy(w1,25,8),  { x2 }
  230.                copy(w1,33,8),  { y2 }
  231.                copy(w1,41,8)); { corner }
  232.   end;
  233.   readln(f1,w1);
  234.   for i:=1 to 7 do
  235.   begin
  236.     readln(f1,w1);
  237.     writeln(f2,'pen_diam[',i,'] = ',w1);
  238.   end;
  239.   readln(f1,w1);
  240.   while not eof(f1) do
  241.   begin
  242.     readln(f1,w1);
  243.     if w1 > '' then writeln(f2,w1);
  244.   end;
  245.   close(f1);
  246. end;
  247.  
  248.  
  249. procedure test;
  250. var
  251.   result : boolean;
  252. begin
  253.   init;
  254.   load_ply('testtool.ply',result);
  255.   if not result then halt;
  256.  
  257.   writeln(f2,remark);
  258.  
  259.   show_fixed_data;
  260.  
  261.   writeln(f2,remark);
  262.  
  263.   show_data;
  264.  
  265.   writeln(f2,remark);
  266.  
  267.   show_cnf('testtool.cnf');
  268.  
  269.   writeln(f2,remark);
  270. end;
  271.  
  272.  
  273.  
  274.  
  275. begin
  276.   assign(f2,'layotool.lst');
  277.   rewrite(f2);
  278.   test;
  279.   close(f2);
  280.   writeln('all output in "layotool.lst"');
  281. end.
  282.  
  283.  
  284.